home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MPW Oberon 2.1168 / JMLCSamples / Marriage.mod < prev    next >
Encoding:
Text File  |  1995-07-03  |  3.7 KB  |  123 lines  |  [TEXT/MPS ]
  1. MODULE Marriage;
  2.  
  3.   IMPORT Clock, Write;
  4.  
  5.   CONST
  6.     n = 8;
  7.   TYPE
  8.     Man = SHORTINT;
  9.     Woman = SHORTINT;
  10.     Rank = SHORTINT;
  11.   VAR
  12.     wmr: ARRAY n+1,n+1 OF Woman;
  13.     mwr: ARRAY n+1,n+1 OF Man;
  14.     rmw: ARRAY n+1,n+1 OF Rank;
  15.     rwm: ARRAY n+1,n+1 OF Rank;
  16.     x: ARRAY n+1 OF Woman;
  17.     y: ARRAY n+1 OF Man;
  18.     single: ARRAY n+1 OF BOOLEAN;
  19.     count: LONGINT;
  20.  
  21.   PROCEDURE SetupMatrices;
  22.   BEGIN
  23.     wmr[1,1]:=7; wmr[1,2]:=2; wmr[1,3]:=6; wmr[1,4]:=5; wmr[1,5]:=1; wmr[1,6]:=3; wmr[1,7]:=8; wmr[1,8]:=4;
  24.     wmr[2,1]:=4; wmr[2,2]:=3; wmr[2,3]:=2; wmr[2,4]:=6; wmr[2,5]:=8; wmr[2,6]:=1; wmr[2,7]:=7; wmr[2,8]:=5;
  25.     wmr[3,1]:=3; wmr[3,2]:=2; wmr[3,3]:=4; wmr[3,4]:=1; wmr[3,5]:=8; wmr[3,6]:=5; wmr[3,7]:=7; wmr[3,8]:=6;
  26.     wmr[4,1]:=3; wmr[4,2]:=8; wmr[4,3]:=4; wmr[4,4]:=2; wmr[4,5]:=5; wmr[4,6]:=6; wmr[4,7]:=7; wmr[4,8]:=1;
  27.     wmr[5,1]:=8; wmr[5,2]:=3; wmr[5,3]:=4; wmr[5,4]:=5; wmr[5,5]:=6; wmr[5,6]:=1; wmr[5,7]:=7; wmr[5,8]:=2;
  28.     wmr[6,1]:=8; wmr[6,2]:=7; wmr[6,3]:=5; wmr[6,4]:=2; wmr[6,5]:=4; wmr[6,6]:=3; wmr[6,7]:=1; wmr[6,8]:=6;
  29.     wmr[7,1]:=2; wmr[7,2]:=4; wmr[7,3]:=6; wmr[7,4]:=3; wmr[7,5]:=1; wmr[7,6]:=7; wmr[7,7]:=5; wmr[7,8]:=8;
  30.     wmr[8,1]:=6; wmr[8,2]:=1; wmr[8,3]:=4; wmr[8,4]:=2; wmr[8,5]:=7; wmr[8,6]:=5; wmr[8,7]:=3; wmr[8,8]:=8;
  31.  
  32.     mwr[1,1]:=4; mwr[1,2]:=6; mwr[1,3]:=2; mwr[1,4]:=5; mwr[1,5]:=8; mwr[1,6]:=1; mwr[1,7]:=3; mwr[1,8]:=7;
  33.     mwr[2,1]:=8; mwr[2,2]:=5; mwr[2,3]:=3; mwr[2,4]:=1; mwr[2,5]:=6; mwr[2,6]:=7; mwr[2,7]:=4; mwr[2,8]:=2;
  34.     mwr[3,1]:=6; mwr[3,2]:=8; mwr[3,3]:=1; mwr[3,4]:=2; mwr[3,5]:=3; mwr[3,6]:=4; mwr[3,7]:=7; mwr[3,8]:=5;
  35.     mwr[4,1]:=3; mwr[4,2]:=2; mwr[4,3]:=4; mwr[4,4]:=7; mwr[4,5]:=6; mwr[4,6]:=8; mwr[4,7]:=5; mwr[4,8]:=1;
  36.     mwr[5,1]:=6; mwr[5,2]:=3; mwr[5,3]:=1; mwr[5,4]:=4; mwr[5,5]:=5; mwr[5,6]:=7; mwr[5,7]:=2; mwr[5,8]:=8;
  37.     mwr[6,1]:=2; mwr[6,2]:=1; mwr[6,3]:=3; mwr[6,4]:=8; mwr[6,5]:=7; mwr[6,6]:=4; mwr[6,7]:=6; mwr[6,8]:=5;
  38.     mwr[7,1]:=3; mwr[7,2]:=5; mwr[7,3]:=7; mwr[7,4]:=2; mwr[7,5]:=4; mwr[7,6]:=1; mwr[7,7]:=8; mwr[7,8]:=6;
  39.     mwr[8,1]:=7; mwr[8,2]:=2; mwr[8,3]:=8; mwr[8,4]:=4; mwr[8,5]:=5; mwr[8,6]:=6; mwr[8,7]:=3; mwr[8,8]:=1;
  40.   END SetupMatrices;
  41.  
  42.   PROCEDURE Print;
  43.     VAR
  44.       m: Man;
  45.       rm, rw: INTEGER;
  46.   BEGIN
  47.     rm:=0; rw:=0;
  48.     FOR m:=1 TO n DO
  49.       (*?? Write.Int(x[m], 4)*); rm:=rm+rmw[m, x[m]]; rw:=rw+rwm[x[m], m]
  50.     END;
  51.     (*?? Write.Int(rm, 8); Write.Int(rw, 4); Write.Ln*)
  52.   END Print;
  53.  
  54.   PROCEDURE Try(m: Man);
  55.     VAR
  56.       r: Rank;
  57.       w: Woman;
  58.  
  59.     PROCEDURE stable(r: Rank; w: Woman; m: Man): BOOLEAN;
  60.       VAR
  61.         pm: Man;
  62.         pw: Woman;
  63.         i, lim: Rank;
  64.         s: BOOLEAN;
  65.     BEGIN
  66.       s:=TRUE; i:=1;
  67.       WHILE (i<r) AND s DO
  68.         pw:=wmr[m,i]; INC(i);
  69.         IF ~single[pw] THEN
  70.           s:=rwm[pw, m]>rwm[pw,y[pw]]
  71.         END
  72.       END;
  73.       i:=1; lim:=rwm[w,m];
  74.       WHILE (i<lim) AND s DO
  75.         pm:=mwr[w,i]; INC(i);
  76.         IF pm<m THEN
  77.           s:=rmw[pm,w]>rmw[pm,x[pm]]
  78.         END
  79.       END;
  80.       RETURN s
  81.     END stable;
  82.  
  83.   BEGIN
  84.     FOR r:=1 TO n DO
  85.       w:=wmr[m,r];
  86.       IF single[w] THEN
  87.         IF stable(r, w, m) THEN
  88.           x[m]:=w; y[w]:=m; single[w]:=FALSE;
  89.           IF m<n THEN
  90.             Try(m+1)
  91.           ELSE
  92.             Print
  93.           END;
  94.           single[w]:=TRUE
  95.         END
  96.       END
  97.     END
  98.   END Try;
  99.  
  100.   PROCEDURE Search;
  101.     VAR
  102.       m: Man;
  103.       w: Woman;
  104.       r: Rank;
  105.   BEGIN
  106.     FOR m:=1 TO n DO
  107.       FOR r:=1 TO n DO rmw[m,wmr[m,r]]:=r END
  108.     END;
  109.     FOR w:=1 TO n DO
  110.       FOR r:=1 TO n DO rwm[w,mwr[w,r]]:=r END
  111.     END;
  112.     FOR w:=1 TO n DO single[w]:=TRUE END;
  113.     Try(1)
  114.   END Search;
  115.  
  116. (*$MAIN+*)
  117. BEGIN
  118.   SetupMatrices; Clock.Start; count:=1;
  119.   REPEAT
  120.     Search; count:=count+1
  121.   UNTIL count>50;
  122.   Write.Int(Clock.Stop() DIV 1000, 1)
  123. END Marriage.